home *** CD-ROM | disk | FTP | other *** search
- {$IFDEF DEBUG}
- {$A+,B-,D+,F-,G-,I-,K-,L-,N-,E-,P-,Q+,R+,S+,T-,V-,W+,X+,Y-}
- {$ELSE}
- {$A+,B-,D-,F-,G-,I-,K-,L-,N-,E-,P-,Q-,R-,S-,T-,V-,W+,X+,Y-}
- {$ENDIf}
-
- {************************************************}
- { }
- { SNAiL ViSiON Demo v1.00.00 }
- { Strange Logic Software <=> Brad Zavitsky }
- { All Rights Reserved (1995) }
- { }
- {************************************************}
-
- {
- | NOTES:
- \-------
-
- There are no known bugs.
-
- Some people have been wondering about computer games so-called AI,
- this is a demo of PAI (Psuedo Artificial Inteligence <g>)
-
- Sorry, no graphics :-), this is just ascii.
-
- I have made most of the games settings constants for changing various
- things around.
-
- If compiling in G+ mode, change COMPSPEED accordingly the enemies
- go MUCH faster.
-
- This will even work on a 8088 in REAL TIME! It has been pretty optimized
- for speed and size, notice, it does not use any units, cut back in a
- ton of linking.
-
- SWAG use it allowed (that is really the goal)
-
- VERSIONS --
- 1.00.00 : First public release. Since I first posted this in the
- PASCAL LESSONS confrence I have made MANY changes to make
- it more of a game/run faster/ and have more configurable
- settings. Est.. *OPERATING Speed is 200%-500% faster.
-
- * I do have a delay which slows things down to regulate speeds.
-
- }
-
- Program Snaildemo;
- {$M $400,0,0}
-
-
- Const
- Top = 3; {Specs of your screen -2/+2}
- Bottom = 22; {""}
- RtSide = 77; {""}
- LftSide = 3; {""}
-
- Version : string[7] = '1.00.00';
- CompSpeed : word = 6; {Higher = easier|Even = Easier}
- MaxEnemy = 68; {Should greater or equal to NumEnemy}
- NumEnemy : word = 30; {Number of enemies}
- AI : Byte = 60; {random move chance}
- Rep : Byte = 3; {Energy replenish}
- JumpChance : Byte = 90; {chance to make a jump}
- BadScore : Integer = -5; {Happens when a jump is failed}
- BadEnergy : Integer = -75; {Happens after a jump is failed}
- MaxEnergy : Word = 5000; {Max amount of energy}
- MaxScore : Word = 65500;
- Drain : Word = 2; {Amount drained per keypress}
- StartingEnergy : Word = 200; {Amount of starting energy}
- Scost : Word = 2; {Shield Usage Cost, if half}
- {then energy wont go down unless moving}
- SNeed : Word = 10; {Energy needed mantain shields}
- StatUpDate : Byte = 5; {When to update stats}
- ENeed : Word = 2; {Energy needed to move}
- JNeed : Word = 100; {Energy needed for hyper jump}
- SnailMan : Char = '@'; {Our hero}
- Langolier : Char = '#'; {Bad Guys}
- SoundOn : Boolean = True; {Turn this off if you don't like noise}
-
- Type
- {Directions used by MOVE}
- Dirtype = (North, East, West, South);
-
- {These are actually player/enemy records, you could probally
- add such things as hitpoints pretty easily}
- CursorRec = Record
- X,Y:Byte;
- End;
-
- { All the possible enemies, I have personally gone up
- to 1000 w/out changing memory! }
- AllEnemy = array[1..MaxEnemy] of CursorRec;
-
-
- Var
- Dead : Boolean; {Gee...what could this mean}
- Round, {Used to regulate stats updates}
- Turn : Byte; {This regulates enemy movement}
- Temp : AllEnemy; {BadGuy location, just what snailman needs to avoid}
- Loc : CursorRec; {Snailmans Location}
- I : Integer; {All purpose integer}
- Len : Byte; {Stores length of previous string for status line}
- Score, { player score}
- Energy : integer; {players current energy}
- OneMs : Word; {Used by delays, DO NOT TOUCH <g>}
- Ch : Char; {IO char}
- ShieldOn : Boolean; {True if shields are on}
- PlayAnother : Boolean; {Play another game?}
-
-
- Procedure CB;Inline($CD/$33); {Simulate a ^C}
-
- Procedure DelayOneMS; assembler; {Better delay for 1ms}
- asm
- PUSH CX { Save CX }
- MOV CX, OneMS { Loop count into CX }
- @1:
- LOOP @1 { Wait one millisecond }
- POP CX { Restore CX }
- end;
-
- Procedure Delay(ms:Word); assembler; {better delay}
- asm
- MOV CX, ms
- JCXZ @2
- @1:
- CALL DelayOneMS
- LOOP @1
- @2:
- end;
-
- Procedure Calibrate_Delay; assembler; {makes delay accurate}
- asm
- MOV AX,40h
- MOV ES,AX
- MOV DI,6Ch { ES:DI is the low word of BIOS timer count }
- MOV OneMS,55 { Initial value for One MS's time }
- XOR DX,DX { DX = 0 }
- MOV AX,ES:[DI] { AX = low word of timer }
- @1:
- CMP AX,ES:[DI] { Keep looking at low word of timer }
- JE @1 { until its value changes... }
- MOV AX,ES:[DI] { ...then save it }
- @2:
- CAll DelayOneMs { Delay for a count of OneMS (55) }
- INC DX { Increment loop counter }
- CMP AX,ES:[DI] { Keep looping until the low word }
- JE @2 { of the timer count changes again }
- MOV OneMS, DX { DX has new OneMS }
- end;
-
- Procedure Beep(Hz, MS:Word); assembler;
- { Make the Sound at Frequency Hz for MS milliseconds }
- ASM
- MOV BX,Hz
- MOV AX,34DDH
- MOV DX,0012H
- CMP DX,BX
- JNC @Stop
- DIV BX
- MOV BX,AX
- IN AL,61H
- TEST AL,3
- JNZ @99
- OR AL,3
- OUT 61H,AL
- MOV AL,0B6H
- OUT 43H,AL
- @99:
- MOV AL,BL
- OUT 42H,AL
- MOV AL,BH
- OUT 42H,AL
- @Stop:
- {$IFOPT G+}
- PUSH MS
- {$ELSE }
- MOV AX, MS { push delay time }
- PUSH AX
- {$ENDIF }
- CALL Delay { and wait... }
-
- IN AL, $61 { Now turn off the speaker }
- AND AL, $FC
- OUT $61, AL
- end;
-
- Procedure BoundsBeep; assembler; {Means you are touching an enemy}
- asm
- {$IFOPT G+ }
- PUSH 1234 { Pass the Frequency }
- PUSH 10 { Pass the delay time }
- {$ELSE}
- MOV AX, 1234 { Pass the Frequency }
- PUSH AX
- MOV AX, 10 { Pass the delay time }
- PUSH AX
- {$ENDIF }
- CALL Beep
- end;
-
- Procedure ErrorBeep; assembler;{Means you have touched an enemy and died}
- asm
- {$IFOPT G+ }
- PUSH 800 { Pass the Frequency }
- PUSH 75 { Pass the delay time }
- {$ELSE}
- MOV AX, 800 { Pass the Frequency }
- PUSH AX
- MOV AX, 75 { Pass the delay time }
- PUSH AX
- {$ENDIF }
- CALL Beep
- end;
-
- Procedure AttentionBeep; assembler; {Status Update beep}
- asm
- {$IFOPT G+ }
- PUSH 660 { Pass the Frequency }
- PUSH 50 { Pass the delay time }
- {$ELSE}
- MOV AX, 660 { Pass the Frequency }
- PUSH AX
- MOV AX, 50 { Pass the delay time }
- PUSH AX
- {$ENDIF }
- CALL Beep
- end;
-
-
-
- Procedure WarpSound; {Attemped warp sound}
- Var I:Word;
- Begin
- For I:= 500 to 600 do Beep(I,10);
- End;
-
- Procedure WarpDown; {Completed warp sound}
- Var I:Word;
- Begin
- For I:= 600 downto 500 do Beep(I,10);
- Delay(200);
- Beep(1000,10);
- Delay(200);
- Beep(1000,10);
- End;
-
-
- Procedure FClr;Assembler; {ClrScr}
- Asm
- MOV AH,0Fh
- Int 10h
- MOV AH,0
- Int 10h
- End;
-
- Procedure GotoXY(X,Y : Byte); Assembler;
- Asm
- MOV DH, Y { DH = Row (Y) }
- MOV DL, X { DL = Column (X) }
- DEC DH { Adjust For Zero-based Bios routines }
- DEC DL { Turbo Crt.GotoXY is 1-based }
- MOV BH,0 { Display page 0 }
- MOV AH,2 { Call For SET CURSOR POSITION }
- INT 10h
- end;
-
- Function Int2Str(Number : LongInt): String;
- Var
- Temp : String[64];
- Begin
- Str(Number,Temp);
- Int2Str := Temp;
- End;
-
- Procedure SetXY(x,y:byte;var A:CursorRec);
- Begin
- If (X > 0) and (X < 80) then A.x := x;
- If (Y > 0) and (Y < 25) then A.y := y;
- End;
-
- Procedure ClearKeyBoard;{Fast key clearer}
- Begin
- ASM CLI End;
- MemW[$40:$1A] := MemW[$40:$1C];
- ASM STI End;
- End;
-
- Procedure GoXY(A:CursorRec); {moves cursorrec to its position}
- Begin
- Gotoxy(a.x,a.y);
- End;
-
- Procedure HideCursor; Assembler;
- Asm
- MOV ax,$0100
- MOV cx,$2607
- INT $10
- end;
-
- Procedure ShowCursor; Assembler;
- Asm
- MOV ax,$0100
- MOV cx,$0506
- INT $10
- end;
-
- Function WhereX : Byte; Assembler;
- Asm
- MOV AH,3 {Ask For current cursor position}
- MOV BH,0 { On page 0 }
- INT 10h { Return inFormation in DX }
- INC DL { Bios Assumes Zero-based. Crt.WhereX Uses 1 based }
- MOV AL, DL { Return X position in AL For use in Byte Result }
- end;
-
- Function WhereY : Byte; Assembler;
- Asm
- MOV AH,3 {Ask For current cursor position}
- MOV BH,0 { On page 0 }
- INT 10h { Return inFormation in DX }
- INC DH { Bios Assumes Zero-based. Crt.WhereY Uses 1 based }
- MOV AL, DH { Return Y position in AL For use in Byte Result }
- end;
-
- Procedure GETXY(A:CursorRec); {set cursorrec}
- Begin
- A.x := WhereX;
- A.y := WhereY;
- End;
-
- Procedure StatusBeep; {Look up, status line has been updated}
- Begin
- AttentionBeep;
- Delay(50);
- AttentionBeep;
- End;
-
-
- Function Readkey:char;Inline($B4/$07/$CD/$21);
-
- function KeyPressed:boolean;assembler;
- asm
- mov ah,$B;
- int $21;
- and al,$FE;
- end;
-
- Procedure ClrBox(X1,Y1,X2,Y2:Byte);
- Var
- OldX :Byte; AnyBt:Byte;
- OldY :Byte; AnyBt2:Byte;
-
- Begin
- OldX := WhereX;
- OldY := WhereY;
- gotoxy(x1,y1);
- For Anybt :=1 to Y2 do begin
- For AnyBt2 :=1 to X2 do write(#0);
- gotoxy(X1,Y1+AnyBt);
- End{For Loop};
- gotoxy(oldX,OldY);
- End;
-
- Procedure Status(S:String;Clear:Boolean;UseSound:Boolean);
- {Gives messages on first line}
- Begin
- If (Clear) and (SoundOn) and (UseSound) then StatusBeep;
- Gotoxy(1,1);
- If Clear then ClrBox(1,1,Len,1) else gotoxy(len,1);
- Write(S);
- If Clear then Len:= Length(S) else Len:= Len + Length(S)+1;
- inc(len);
- Goxy(Loc);
- End;
-
- Function P100(Percent:Word):Boolean; {Percentage 100}
- Begin
- P100 := False;
- If Random(100)+1 <= Percent then P100 := True;
- End;
-
- Procedure StatInit; {Set up status bar |not status line|}
- Begin
- gotoxy(1,2);
- Write('[ STATUS ] ENERGY: SHIELDS: SCORE:');
- End;
-
- {The following procedure update the status bar}
-
- Procedure UpDateEnergy;
- Var i:Byte;
- Begin
- Gotoxy(21,2);
- For I:=1 to 5 do write(#32);
- Gotoxy(21,2);
- Write(Energy);
- Goxy(Loc);
- End;
-
- Procedure UpDateShields;
- Var i:Byte;
- Begin
- StatusBeep;
- Gotoxy(41,2);
- For I:=1 to 5 do write(#32);
- Gotoxy(41,2);
- Write(ShieldOn);
- Goxy(Loc);
- End;
-
- Procedure UpDateScore;
- Var i:Byte;
- Begin
- Gotoxy(59,2);
- For I:=1 to Length(int2str(Energy))+2 do write(#32);
- gotoxy(59,2);
- Write(Score);
- Goxy(Loc);
- End;
-
- Procedure EngageShields; {Change shield status}
- Begin
- ShieldOn := not ShieldOn;
- UpDateShields;
- End;
-
- procedure Firephasers(A:CursorRec); {Check for collisions}
- begin
- If (A.x = Loc.x) and (A.Y = Loc.Y) then
- begin
- BoundsBeep;
- GoXy(A);
- Write(Langolier);
- If not shieldOn then
- begin
- If SoundOn then ErrorBeep;
- Dead := True;
- End;{ShieldOn}
- end;{If Locs match}
- End;{Fire}
-
- Procedure CheckHits; {Check for collisions}
- Var I:word;
- Begin
- While not dead and (I <> NumEnemy) do
- For I:= 1 to NumEnemy do Firephasers(Temp[I]);
- End;
-
- Function Move(Dir:DirType;Var A:CursorRec;Ch:Char):Boolean;
- {Move player/enemies}
- Begin
- Move := True;
- Case Dir of
- North: Begin
- If A.Y <= top then Move := False else
- begin
- goxy(A);
- Write(#0);
- Dec(A.Y);
- GoXY(A);
- Write(Ch);
- End;{If wherey}
- End;{K_Up}
-
- South: Begin
- If A.Y >= bottom then Move := False else
- begin
- goxy(A);
- Write(#0);
- Inc(A.Y);
- GoXY(A);
- Write(ch);
- End;{If wherey}
- End;{K_Down}
-
- East: Begin
- If A.X >= rtside then Move := False else
- begin
- goxy(A);
- Write(#0);
- Inc(A.X);
- GoXY(A);
- Write(Ch);
- End;{If wherex}
- End;{K_Right}
-
- West: Begin
- If A.X <= lftside then Move := False else
- begin
- goxy(A);
- write(#0);
- Dec(A.X);
- GoXY(A);
- Write(Ch);
- End;{If wherex}
- End;{K_Left}
-
- End;{Case}
- CheckHits;
- End;{Move}
-
- Procedure Jump; {Hyper Jump}
- Begin
- Status('Attempting Jump...',True,False);
- If SoundOn then WarpSound;
- If Energy >= Jneed then
- begin
- If P100(JumpChance) then {If you don't fail...}
- begin
- Goxy(Loc);
- Write(#0);
- SetXy((random(rtside-lftside)+lftside+1),(random(bottom-top)+top+1)
- ,Loc);
- goxy(Loc);
- Write(snailman);
- Dec(Energy, Jneed); {Get rid of used energy}
- Status('successfull',false,True);
- If SoundOn then WarpDown; {make some noise}
- End Else
- Begin
- Delay(200); {Failed Warp Noise}
- Beep(1500,20);
- Delay(200);
- Beep(1500,20);
- Delay(200);
- Beep(1500,20);
- Delay(200);
- Beep(1500,20);
- Status('Failed',False,True);
- Energy := BadEnergy; {Pay the price of a blown engine}
- Score := BadScore; {""}
- End;
- End else Begin
- status('not enough energy!',false,True);
- Delay(200);
- Beep(1000,10);
- End;
- End;
-
- procedure Movefoes; {The enemy is on the move}
- Var I:Word;
- begin
- Turn := 0; {reset turns}
- For I:=1 to numenemy do
- Begin
-
- If Temp[I].X > Loc.X then Move(West,Temp[I],langolier) else
- If Temp[I].X < Loc.X then Move(East,Temp[I],langolier);
-
- If Temp[I].Y > Loc.Y then Move(North,Temp[I],langolier) else
- If Temp[I].Y < Loc.Y then Move(South,Temp[I],langolier);
-
-
- If P100(AI) then {do they move on their own?}
- begin
- case (random(4)+1) of
- 1: Move(North,Temp[I],langolier);
- 2: Move(South,Temp[I],langolier);
- 3: Move(West,Temp[I],langolier);
- 4: Move(East,Temp[I],langolier);
- End;{Case}
- End;{Begin}
- end;{for to do}
- {EnemySave;}
- end;
-
- procedure Addscore; {regulates energy use, this could use some work}
- begin
- if (energy < MaxEnergy) and (odd(turn)) then inc(energy,rep);
- if (score < MaxScore) and (turn = compspeed-1) then inc(score);
- end;
-
-
- procedure Playgame; {Let the games begin}
- Var i:Word;
- begin
- For I:=1 to numenemy do {set up starting positions}
- begin
- SetXy((random(rtside-lftside)+lftside+1),(random(bottom-top)+top+1)
- ,Temp[I]);
- goxy(Temp[I]);
- Write(langolier);
- end;
-
- SetXy(3,5,Loc);
- goxy(loc);
- Write(snailman);
- repeat {begin}
- While keypressed do {MUCH faster than "If Keyressed"}
- Begin
- Ch := readkey;
- If (CH = #0) and (ENergy > ENeed) then
- {a function key means they are moving}
- BEGIN
- Dec(Energy, Drain);
- Ch := Readkey;
- Case CH of
- { left } #75 : Move(West,Loc,snailman);
- { rite } #77 : Move(East,Loc,snailman);
- { Up } #72 : Move(North, Loc, snailman);
- { Down } #80 : Move(South, Loc,snailman);
- { PGup } #73 : Begin
- Move(North, Loc, snailman);
- Move(East,Loc,snailman);
- End;
-
- { PDdn } #81 : Begin
- Move(South, Loc,snailman);
- Move(East,Loc,snailman);
- End;
-
- { Home } #71 : Begin
- Move(North, Loc, snailman);
- Move(West,Loc,snailman);
- End;
-
- { End } #79 : Begin
- Move(South, Loc, snailman);
- Move(West,Loc,snailman);
- End;
-
- End;{Case}
- END ELSE
- Case Ch of
- 'Q','q' : Dead := True;{Quit}
- 'J','j' : Jump; {Jump}
- 'S','s' : EngageShields;{Engage/disEngage shields}
- 'P','p' : Begin
- Inc(Energy, Drain); {Reimburse energy}
- Status('Paused... press <ENTER>',true,True);
- repeat until readkey = #13;
- Status('',True,True);
- End;
-
- #3 : CB; {^C}
- End;{case}
- End;{While}
-
- If (Energy < SNeed) and (ShieldOn) then
- Begin
- ShieldOn := False;
- UpDateShields;
- End;
-
- If ShieldOn then Dec(Energy, SCost);
- ClearKeyBoard;
-
- If Round = StatUpDate then
- Begin
- GoXy(Loc);
- Write(SnailMan);
- UpDateEnergy;
- UpDateScore;
- Round := 0;
- End;
- inc(Round);
-
- If turn >= compspeed then movefoes;
- inc(turn);
-
- addscore;
- Delay(100);
- {end} until dead;
- end;
-
- Procedure SayHi; {Internal Instructions}
- Begin
- Writeln('Welcome to SNAiL ViSiON -- The virtual snail network -- ');
- Writeln('and only on channel 3031. Tonight we bring you, once again,');
- Writeln('SNAiL MAN! Can the not-so-brave-and-not-too-tough SNAiLMAN');
- Writeln('save the day? Well, as you know, with ViRTUAL SNAiL REALiTY');
- Writeln('you will decide. And just how do you win you ask? Well the');
- Writeln('snail isn''t known for it''s ninja-like karate skills, so');
- Writeln('you just have to run as only a snail can.');
- Writeln('');
- Writeln('Advice --');
- Writeln(' When you here two beeps, look up, it means something has');
- Writeln(' just been updated. Also, be carefull when using');
- Writeln(' HyperJump,if you fail you loose energy and points');
- Writeln('');
- Writeln('Instructions --');
- Writeln(' Arrow keys move you in corresponding directions.');
- Writeln(' PgUp, PgDn, Home, and End move diagonaly.');
- Writeln(' P - Pause Q - Commit Sucicide S - Engage Snail Shields');
- Writeln(' J - Snail HyperJump!');
- Writeln('');
- Writeln('Symbols --');
- Writeln(' ',SnailMan,' - Snailman ',Langolier,' - Langolier');
- Writeln('');
- Write('<Press Enter> [ ]'#8#8);
- Repeat until readkey = #13;
- Fclr;
- End;
-
- begin {main program}
- (***********************************************************************)
- Calibrate_Delay;
- Delay(0);
- PlayAnother := True;
-
- Repeat
- randomize;
- NumEnemy := Random(16)+15;
- Dead := False;
- Score := 0;
- Turn := 0;
- Fclr;
- SayHi;
- HideCursor;
- ClearKeyBoard;
- Energy := StartingEnergy;
- ShieldOn := False;
- StatInit;
- UpDateShields;
- (***********************************************************************)
-
- Status('Welcome to SNAiL ViSiON v'+version+' ...',True,False);
-
- Playgame;
-
-
- (***********************************************************************)
- ShowCursor;
- FCLR; {Not only clears the screen, but resets some things as well}
- Writeln('Score: ',Score);
- Write('Play again? (Y/n)');
- Repeat
- Ch := UpCase(Readkey);
- Until (Ch = 'Y') or (CH = 'N');
- If Ch = 'N' then playanother := False;
- Until not PlayAnother;
- Fclr;
- (***********************************************************************)
- end.
-
- :::